{
 *  Copyright (c) 2012 Andrey Kemka
 *
 *  This software is provided 'as-is', without any express or
 *  implied warranty. In no event will the authors be held
 *  liable for any damages arising from the use of this software.
 *
 *  Permission is granted to anyone to use this software for any purpose,
 *  including commercial applications, and to alter it and redistribute
 *  it freely, subject to the following restrictions:
 *
 *  1. The origin of this software must not be misrepresented;
 *     you must not claim that you wrote the original software.
 *     If you use this software in a product, an acknowledgment
 *     in the product documentation would be appreciated but
 *     is not required.
 *
 *  2. Altered source versions must be plainly marked as such,
 *     and must not be misrepresented as being the original software.
 *
 *  3. This notice may not be removed or altered from any
 *     source distribution.
}
unit zgl_sengine_2d;

{$I zgl_config.cfg}

interface

uses
  zgl_textures;

type
  zglPSprite2D = ^zglTSprite2D;
  zglPSEngine2D = ^zglTSEngine2D;

  zglTSEngine2D = record
    Count : Integer;
    List  : array of zglPSprite2D;
  end;

  zglTSprite2D = record
    ID      : Integer;
    Manager : zglPSEngine2D;
    Texture : zglPTexture;
    Destroy : Boolean;
    Layer   : Integer;
    X, Y    : Single;
    W, H    : Single;
    Angle   : Single;
    Frame   : Single;
    Alpha   : Integer;
    FxFlags : LongWord;

    OnInit  : procedure( var Sprite );
    OnDraw  : procedure( var Sprite );
    OnProc  : procedure( var Sprite );
    OnFree  : procedure( var Sprite );
  end;

function  sengine2d_AddSprite( Texture : zglPTexture; Layer : Integer; OnInit, OnDraw, OnProc, OnFree : Pointer ) : zglPSprite2D;
function  sengine2d_AddCustom( Texture : zglPTexture; Size : LongWord; Layer : Integer; OnInit, OnDraw, OnProc, OnFree : Pointer ) : zglPSprite2D;
procedure sengine2d_DelSprite( ID : Integer );
procedure sengine2d_ClearAll;

procedure sengine2d_Set( SEngine : zglPSEngine2D );
function  sengine2d_Get : zglPSEngine2D;
procedure sengine2d_Draw;
procedure sengine2d_Proc;

implementation
uses
  zgl_main,
  zgl_fx,
  zgl_sprite_2d;

var
  _sengine  : zglTSEngine2D;
  sengine2d : zglPSEngine2D;

function sengine2d_AddSprite( Texture : zglPTexture; Layer : Integer; OnInit, OnDraw, OnProc, OnFree : Pointer ) : zglPSprite2D;
begin
  Result := sengine2d_AddCustom( Texture, SizeOf( zglTSprite2D ), Layer, OnInit, OnDraw, OnProc, OnFree );
end;

function sengine2d_AddCustom( Texture : zglPTexture; Size : LongWord; Layer : Integer; OnInit, OnDraw, OnProc, OnFree : Pointer ) : zglPSprite2D;
  var
    new : zglPSprite2D;
begin
  if sengine2d.Count + 1 > Length( sengine2d.List ) Then
    SetLength( sengine2d.List, Length( sengine2d.List ) + 1024 );

  zgl_GetMem( Pointer( new ), Size );
  sengine2d.List[ sengine2d.Count ] := new;
  INC( sengine2d.Count );

  new.ID      := sengine2d.Count - 1;
  new.Manager := sengine2d;
  new.Texture := Texture;
  new.Layer   := Layer;
  new.X       := 0;
  new.Y       := 0;
  new.W       := Round( ( Texture.FramesCoord[ 1, 1 ].X - Texture.FramesCoord[ 1, 0 ].X ) * Texture.Width / Texture.U );
  new.H       := Round( ( Texture.FramesCoord[ 1, 0 ].Y - Texture.FramesCoord[ 1, 2 ].Y ) * Texture.Height / Texture.V );
  new.Angle   := 0;
  new.Frame   := 1;
  new.Alpha   := 255;
  new.FxFlags := FX_BLEND;
  new.OnInit  := OnInit;
  new.OnDraw  := OnDraw;
  new.OnProc  := OnProc;
  new.OnFree  := OnFree;
  Result      := new;
  if Assigned( Result.OnInit ) Then
    Result.OnInit( Result^ );
end;

procedure sengine2d_DelSprite( ID : Integer );
  var
    i : Integer;
begin
  if ( ID < 0 ) or ( ID > sengine2d.Count - 1 ) or ( sengine2d.Count = 0 ) Then exit;

  if Assigned( sengine2d.List[ ID ].OnFree ) Then
    sengine2d.List[ ID ].OnFree( sengine2d.List[ ID ]^ );

  FreeMem( sengine2d.List[ ID ] );
  sengine2d.List[ ID ] := nil;
  for i := ID to sengine2d.Count - 2 do
    begin
      sengine2d.List[ i ]    := sengine2d.List[ i + 1 ];
      sengine2d.List[ i ].ID := i;
    end;

  DEC( sengine2d.Count );
end;

procedure sengine2d_ClearAll;
  var
    i : Integer;
    s : zglPSprite2D;
begin
  for i := 0 to sengine2d.Count - 1 do
    begin
      s := sengine2d.List[ i ];
      if Assigned( s.OnFree ) Then
        sengine2d.List[ i ].OnFree( s^ );
      FreeMem( s );
    end;
  SetLength( sengine2d.List, 0 );
  sengine2d.Count := 0;
end;

procedure sengine2d_Set( SEngine : zglPSEngine2D );
begin
  if Assigned( SEngine ) Then
    sengine2d := SEngine
  else
    sengine2d := @_sengine;
end;

function sengine2d_Get : zglPSEngine2D;
begin
  Result := sengine2d;
end;

procedure sengine2d_Draw;
  var
    i : Integer;
    s : zglPSprite2D;
begin
  i := 0;
  while i < sengine2d.Count do
    begin
      s := sengine2d.List[ i ];
      if Assigned( s.OnDraw ) Then
        s.OnDraw( s^ )
      else
        asprite2d_Draw( s.Texture, s.X, s.Y, s.W, s.H, s.Angle, Round( s.Frame ), s.Alpha, s.FxFlags );

      if Assigned( s ) Then
        begin
          if s.Destroy Then
            sengine2d_DelSprite( s.ID )
          else
            INC( i );
        end;
    end;
end;

procedure sengine2d_Sort( iLo, iHi : Integer );
  var
    lo, hi, mid : Integer;
    t : zglPSprite2D;
begin
  lo   := iLo;
  hi   := iHi;
  mid  := sengine2d.List[ ( lo + hi ) shr 1 ].Layer;

  with sengine2d^ do
  repeat
    while List[ lo ].Layer < mid do INC( lo );
    while List[ hi ].Layer > mid do DEC( hi );
    if lo <= hi then
      begin
        t          := List[ lo ];
        List[ lo ] := List[ hi ];
        List[ hi ] := t;
        INC( lo );
        DEC( hi );
      end;
  until lo > hi;

  if hi > iLo Then sengine2d_Sort( iLo, hi );
  if lo < iHi Then sengine2d_Sort( lo, iHi );
end;

procedure sengine2d_SortID( iLo, iHi : Integer );
  var
    lo, hi, mid : Integer;
    t : zglPSprite2D;
begin
  lo   := iLo;
  hi   := iHi;
  mid  := sengine2d.List[ ( lo + hi ) shr 1 ].ID;

  with sengine2d^ do
  repeat
    while List[ lo ].ID < mid do INC( lo );
    while List[ hi ].ID > mid do DEC( hi );
    if lo <= hi then
      begin
        t          := List[ lo ];
        List[ lo ] := List[ hi ];
        List[ hi ] := t;
        INC( lo );
        DEC( hi );
      end;
  until lo > hi;

  if hi > iLo Then sengine2d_SortID( iLo, hi );
  if lo < iHi Then sengine2d_SortID( lo, iHi );
end;

procedure sengine2d_Proc;
  var
    i, a, b, l : Integer;
    s          : zglPSprite2D;
begin
  i := 0;
  while i < sengine2d.Count do
    begin
      s := sengine2d.List[ i ];
      if Assigned( s.OnProc ) Then
        s.OnProc( s^ );

      if Assigned( s ) Then
        begin
          if s.Destroy Then
            sengine2d_DelSprite( s.ID )
          else
            INC( i );
        end;
    end;

  if sengine2d.Count > 1 Then
    begin
      l := 0;
      for i := 0 to sengine2d.Count - 1 do
        begin
          s := sengine2d.List[ i ];
          if s.Layer > l Then l := s.Layer;
          if s.Layer < l Then
            begin
              sengine2d_Sort( 0, sengine2d.Count - 1 );
              // TODO: provide parameter for enabling/disabling stable sorting
              l := sengine2d.List[ 0 ].Layer;
              a := 0;
              for b := 0 to sengine2d.Count - 1 do
                begin
                  s := sengine2d.List[ b ];
                  if ( l <> s.Layer ) Then
                    begin
                      sengine2d_SortID( a, b - 1 );
                      a := b;
                      l := s.Layer;
                    end;
                  if b = sengine2d.Count - 1 Then
                    sengine2d_SortID( a, b );
                end;
              for a := 0 to sengine2d.Count - 1 do
                sengine2d.List[ a ].ID := a;
              break;
            end;
        end;
    end;
end;

initialization
  sengine2d := @_sengine;

end.
